home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 04 - 1988 / 04.10 Oct 88 / Basic / ColorPicker Demo Source < prev   
Encoding:
Text File  |  1988-08-07  |  2.2 KB  |  72 lines  |  [TEXT/TRUE]
  1. !Color Picker Demo
  2. !Demonstrates True Basic's True Windows and
  3. !illustrates use of the Color Picker routine
  4. !©1988 MacTutor
  5. !By Dave Kelly
  6.  
  7. LIBRARY "TrueWindows*","QuickLib*","PickerLib*"
  8. LIBRARY  "datalib*", "maclib*", "system*"
  9.  
  10. DECLARE DEF H,V,GetColor$,UnpackEnvirons$,RGB$
  11. DIM menu$(0:1,0:2)
  12. LET false=0
  13. LET true=1
  14. LET Done=false
  15. CALL tw_init("COLOR")             ! Color isn't supported yet, but I'm ready for it!
  16. ! Find out what kind of computer this is
  17. CALL SysEnvirons(sysEnvRec$,status)
  18. CALL UnpackEnvirons(sysEnvRec$,envversion,machine,sysversion, processor, hasFPU,hasColorQD,keyboardtype,atversion, sysvrefnum)
  19. IF hasColorQD<>1 then
  20.    ! we gotta quit, this isn't a Mac II
  21.    LET done=true
  22.    CALL tw_dwarn(3,"Color Quickdraw is not available!  Sorry, but you can't run this     !","OK",1,result)
  23. END IF
  24. IF done<> true then
  25.    MAT READ menu$
  26.    DATA "",About MacTutor Picker Demo...,""
  27.    DATA File,Get Picker...,Quit
  28.    CALL tw_menu_set(menu$)        ! Set up the menu
  29.  
  30.    DO
  31.       CALL tw_event(maxnum,type$,window,menunumber,menuitem)
  32.       SELECT CASE type$
  33.       CASE "MENU"
  34.            SELECT CASE menunumber
  35.            CASE 0
  36.                 CALL About
  37.            CASE 1
  38.                 CALL file(menuitem,done,inrgb$)
  39.            CASE ELSE
  40.            END SELECT
  41.       CASE ELSE
  42.       END SELECT
  43.    LOOP Until Done=true
  44.    CALL tw_menu_clear             ! Get rid of the menus
  45. END IF
  46. CALL tw_cleanup                   ! clean up all the TrueWindows stuff
  47. END
  48.  
  49. SUB about
  50.     ! Set up the About dialog box.
  51.     CALL tw_dwarn(0,"MacTutor Picker Demo|©1988 MacTutor|By Dave Kelly","OK",1,Result)
  52. END SUB
  53.  
  54. SUB file(menuitem,done,inrgb$)
  55.     SELECT CASE menuitem
  56.     CASE 1
  57.          ! Set up the upper corner of picker dialog
  58.          CALL SetPt(Point$,0,0)
  59.          ! do picker dialog
  60.          CALL GetColor(point$,"Pick a color, just for fun!",inrgb$,outrgb$,okflag)
  61.          ! select the color
  62.          IF okflag=1 then LET inrgb$=outrgb$
  63.          CALL unpackRGB(inrgb$,r,g,b)
  64.          LET string$="Color selected was:|r="&str$(r)&"|g="&str$(g)&"|b="&str$(b)
  65.          ! Display the color in rgb coordinates
  66.          CALL tw_dwarn(1,string$,"OK",1,result)
  67.     CASE 2
  68.          LET done=1
  69.     CASE ELSE
  70.     END SELECT
  71. END SUB
  72.